For this project the location information is one of the defining aspects of the project and future developments. The data is entered into the table as the raw variable called “Exposure.Location”. This is the baseline gps information we are able to obtain from the data. There are a several packages that allow for these functions to work.

library()

Adding information to the total Exposures released since 2021 delta outbreak

Started on day …

Exposure database

[PRIVATE?? unverified as of sept 01]

This database can be extended however the current vertified database include exposure locations from xx date to xx data, Suburb.

Locations are reported on the ACT Health site including

Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Ctrl+Alt+I.

library(lubridate)
## 
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
library(tidyverse)

tab3 <- read_csv("https://raw.githubusercontent.com/green-striped-gecko/covid_canberra/main/data/last.csv")
## Rows: 336 Columns: 12
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (9): Status, Exposure.Location, Street, Suburb, Date, Arrival.Time, Depa...
## dbl (2): lat, lon
## lgl (1): moved
## 
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.
str(tab3)
## spec_tbl_df [336 x 12] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ Status           : chr [1:336] "New" "New" "New" "New" ...
##  $ Exposure.Location: chr [1:336] "Metro Petroleum Mitchell" "TSG Jamison" "Hip Pocket Workwear & Safety" "Westfield Woden" ...
##  $ Street           : chr [1:336] "Lysaght Street" "Jamison Plaza, Bowman Street" "Shop 1, The Paul's Centre, Hindmarsh Drive" "Westfield Woden, Keltie Street" ...
##  $ Suburb           : chr [1:336] "Mitchell" "Macquarie" "Phillip" "Phillip" ...
##  $ Date             : chr [1:336] "04/09/2021 - Saturday" "04/09/2021 - Saturday" "03/09/2021 - Friday" "03/09/2021 - Friday" ...
##  $ Arrival.Time     : chr [1:336] "3:15pm" "10:30am" "10:40am" "2:50pm" ...
##  $ Departure.Time   : chr [1:336] "3:50pm" "11:30am" "11:30am" "3:50pm" ...
##  $ Contact          : chr [1:336] "Monitor" "Monitor" "Casual" "Monitor" ...
##  $ lat              : num [1:336] -35.2 -35.3 -35.3 -35.3 -35.2 ...
##  $ lon              : num [1:336] 149 149 149 149 149 ...
##  $ doubles          : chr [1:336] "<strong/>!Location has more than<br> one entry. Zoom in and search table!</strong/>" NA NA "<strong/>!Location has more than<br> one entry. Zoom in and search table!</strong/>" ...
##  $ moved            : logi [1:336] TRUE FALSE FALSE TRUE TRUE FALSE ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Status = col_character(),
##   ..   Exposure.Location = col_character(),
##   ..   Street = col_character(),
##   ..   Suburb = col_character(),
##   ..   Date = col_character(),
##   ..   Arrival.Time = col_character(),
##   ..   Departure.Time = col_character(),
##   ..   Contact = col_character(),
##   ..   lat = col_double(),
##   ..   lon = col_double(),
##   ..   doubles = col_character(),
##   ..   moved = col_logical()
##   .. )
##  - attr(*, "problems")=<externalptr>
# names(tab3)
datyl <-factor(tab3$Contact)
# levels(datyl)

datyl1 <- tab3 %>%
           filter(Status >= "New")

names(tab3)
##  [1] "Status"            "Exposure.Location" "Street"           
##  [4] "Suburb"            "Date"              "Arrival.Time"     
##  [7] "Departure.Time"    "Contact"           "lat"              
## [10] "lon"               "doubles"           "moved"
# colsN <- cols[datyl1]

tab4 <- tab3 %>%
  mutate(colsN = factor(Contact, levels = c("Close", "Casual", "Monitor","Investigation location")),
         Contact = factor(Contact, levels = c("Close", "Casual","Monitor", "Investigation location")))


levels(tab4$colsN) <- c("purple", "red","orange",  "grey50")
levels(tab4$colsN) <- c( "yellow", "red","cyan", "blue")
table(tab4$colsN)
## 
## yellow    red   cyan   blue 
##     20    126    189      0
names(tab4)
##  [1] "Status"            "Exposure.Location" "Street"           
##  [4] "Suburb"            "Date"              "Arrival.Time"     
##  [7] "Departure.Time"    "Contact"           "lat"              
## [10] "lon"               "doubles"           "moved"            
## [13] "colsN"
tab4 %>%
  mutate(conDate = as.Date(lubridate::dmy(Date)),
         locName = as.factor(Exposure.Location))
##loc summaries
tab5 <- tab4 %>%
  mutate(conDate = as.Date(lubridate::dmy(Date)),
         locName = as.factor(Suburb)) 

a <- as.data.frame(table(tab5$locName))

colnames(a) <- c("locName", "contactcount")

# head(a)
# str(a)
# filter(a, contactcount >=1)

plotsumms <- right_join(tab5, a)
## Joining, by = "locName"
print(a)
##             locName contactcount
## 1           Ainslie            2
## 2            Amaroo            5
## 3            Barton            1
## 4         Belconnen           21
## 5           Braddon            6
## 6  Braddon & Turner            1
## 7           Calwell            3
## 8          Campbell            8
## 9  Canberra Airport            6
## 10    Canberra City           20
## 11            Casey           12
## 12        Charnwood            1
## 13          Chifley            1
## 14         Chisholm           14
## 15           Conder           14
## 16            Crace            1
## 17  Denman Prospect            1
## 18          Dickson           14
## 19            Evatt            1
## 20           Florey            4
## 21         Franklin            2
## 22         Fyshwick           19
## 23         Greenway           13
## 24         Griffith            2
## 25        Gungahlin           21
## 26           Hawker            3
## 27             Holt           15
## 28           Kaleen            2
## 29          Lyneham            2
## 30        Macquarie            4
## 31      Majura Park            3
## 32           Mawson           10
## 33         Mitchell            4
## 34      Narrabundah            4
## 35        Ngunnawal            3
## 36         Nicholls            2
## 37       Palmerston            3
## 38          Phillip           33
## 39         Pialligo            4
## 40 Public Transport           16
## 41           Turner            2
## 42        Wanniassa           10
## 43           Watson            4
## 44           Weston           17
## 45            Woden            2
str(a)
## 'data.frame':    45 obs. of  2 variables:
##  $ locName     : Factor w/ 45 levels "Ainslie","Amaroo",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ contactcount: int  2 5 1 21 6 1 3 8 6 20 ...
# Aggregate method
# labs <- paste(plotsumms$Exposure.Location, plotsumms$Date,plotsumms$Arrival.Time, plotsumms$Departure.Time, sep="<br/>") 

nrow(tab4)
## [1] 336
#> [1] 100
nrow(distinct(plotsumms, Suburb))
## [1] 45
b <- distinct(plotsumms, Suburb, .keep_all = TRUE)
# subsTable <- semi_join(tab4, b)


#> [1] 69
# nrow(distinct(df, x, y))
# #> [1] 69
levels(plotsumms$locName)
##  [1] "Ainslie"          "Amaroo"           "Barton"           "Belconnen"       
##  [5] "Braddon"          "Braddon & Turner" "Calwell"          "Campbell"        
##  [9] "Canberra Airport" "Canberra City"    "Casey"            "Charnwood"       
## [13] "Chifley"          "Chisholm"         "Conder"           "Crace"           
## [17] "Denman Prospect"  "Dickson"          "Evatt"            "Florey"          
## [21] "Franklin"         "Fyshwick"         "Greenway"         "Griffith"        
## [25] "Gungahlin"        "Hawker"           "Holt"             "Kaleen"          
## [29] "Lyneham"          "Macquarie"        "Majura Park"      "Mawson"          
## [33] "Mitchell"         "Narrabundah"      "Ngunnawal"        "Nicholls"        
## [37] "Palmerston"       "Phillip"          "Pialligo"         "Public Transport"
## [41] "Turner"           "Wanniassa"        "Watson"           "Weston"          
## [45] "Woden"
# distinct(df, x)
plotsumms <- b
plotsumms$Suburb[35] <- "O'Connor" 
plotsumms$locName[35] <- "O'Connor"
## Warning in `[<-.factor`(`*tmp*`, 35, value = structure(c(33L, 30L, 38L, :
## invalid factor level, NA generated
# plotsumms$Suburb <- droplevels(plotsumms$Suburb)
# plotsumms$locName <- droplevels(plotsumms$locName)

clean <- plotsumms$Exposure.Location[4] <- "Assembly The People Pub"

# pre-processing
# ensure that all characters in the `Name` column
# are valid UTF-8 encoded
# Thank you to SO for this gem 
# https://stackoverflow.com/questions/17291287/how-to-identify-delete-non-utf-8-characters-in-r
Encoding(x = plotsumms$Exposure.Location) <- "UTF-8"

# replace all non UTF-8 character strings with an empty space
plotsumms$Exposure.Location <-
  iconv( x = plotsumms$Exposure.Location
         , from = "UTF-8"
         , to = "UTF-8"
         , sub = "" )


labs <- paste(plotsumms$Exposure.Location, plotsumms$Date,plotsumms$Arrival.Time, plotsumms$Departure.Time, sep="<br/>") 

leaflet(plotsumms) %>% addTiles() %>%
  addCircleMarkers(lat=plotsumms$lat,
                            lng=plotsumms$lon,
                   weight = 0.2, 
    radius = log(plotsumms$contactcount)*5, 
                            color = plotsumms$colsN,
                            stroke = TRUE,
                            fill = rep("black", length(plotsumms$colsN)),
                            popup = paste0(" COUNT:", plotsumms$contactcount),
                            fillOpacity = 0.8
                            ) %>%
  addCircles(lat=tab4$lat,lng=tab4$lon,
             popup = paste0(plotsumms$Exposure.Location," ", plotsumms$Date))
# %>%
#     group_by(locName) %>%
#       summarise(countPlace = count(Place))
# # %>%
#   group_by(Suburb) %>%
#     summarise(FirstCase = min(conDate),
#               LastCase = max(conDate),
#               caseCount = sum(unique(Place)))

# write.csv(x = plotsumms, "data/outSubs.csv")

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.

Location x,y information

This needs to account for projection, crs, points, polygons, SA levels etc…

Locations are reported on the ACT Health site including

Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Ctrl+Alt+I.

library(lubridate)
library(tidyverse)

tab3 <- read_csv("https://raw.githubusercontent.com/green-striped-gecko/covid_canberra/main/data/last.csv")
## Rows: 336 Columns: 12
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (9): Status, Exposure.Location, Street, Suburb, Date, Arrival.Time, Depa...
## dbl (2): lat, lon
## lgl (1): moved
## 
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.
str(tab3)
## spec_tbl_df [336 x 12] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ Status           : chr [1:336] "New" "New" "New" "New" ...
##  $ Exposure.Location: chr [1:336] "Metro Petroleum Mitchell" "TSG Jamison" "Hip Pocket Workwear & Safety" "Westfield Woden" ...
##  $ Street           : chr [1:336] "Lysaght Street" "Jamison Plaza, Bowman Street" "Shop 1, The Paul's Centre, Hindmarsh Drive" "Westfield Woden, Keltie Street" ...
##  $ Suburb           : chr [1:336] "Mitchell" "Macquarie" "Phillip" "Phillip" ...
##  $ Date             : chr [1:336] "04/09/2021 - Saturday" "04/09/2021 - Saturday" "03/09/2021 - Friday" "03/09/2021 - Friday" ...
##  $ Arrival.Time     : chr [1:336] "3:15pm" "10:30am" "10:40am" "2:50pm" ...
##  $ Departure.Time   : chr [1:336] "3:50pm" "11:30am" "11:30am" "3:50pm" ...
##  $ Contact          : chr [1:336] "Monitor" "Monitor" "Casual" "Monitor" ...
##  $ lat              : num [1:336] -35.2 -35.3 -35.3 -35.3 -35.2 ...
##  $ lon              : num [1:336] 149 149 149 149 149 ...
##  $ doubles          : chr [1:336] "<strong/>!Location has more than<br> one entry. Zoom in and search table!</strong/>" NA NA "<strong/>!Location has more than<br> one entry. Zoom in and search table!</strong/>" ...
##  $ moved            : logi [1:336] TRUE FALSE FALSE TRUE TRUE FALSE ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Status = col_character(),
##   ..   Exposure.Location = col_character(),
##   ..   Street = col_character(),
##   ..   Suburb = col_character(),
##   ..   Date = col_character(),
##   ..   Arrival.Time = col_character(),
##   ..   Departure.Time = col_character(),
##   ..   Contact = col_character(),
##   ..   lat = col_double(),
##   ..   lon = col_double(),
##   ..   doubles = col_character(),
##   ..   moved = col_logical()
##   .. )
##  - attr(*, "problems")=<externalptr>
# names(tab3)
datyl <-factor(tab3$Contact)
# levels(datyl)

datyl1 <- tab3 %>%
           filter(Status >= "New")

names(tab3)
##  [1] "Status"            "Exposure.Location" "Street"           
##  [4] "Suburb"            "Date"              "Arrival.Time"     
##  [7] "Departure.Time"    "Contact"           "lat"              
## [10] "lon"               "doubles"           "moved"
# colsN <- cols[datyl1]

tab4 <- tab3 %>%
  mutate(colsN = factor(Contact, levels = c("Close", "Casual", "Monitor","Investigation location")),
         Contact = factor(Contact, levels = c("Close", "Casual","Monitor", "Investigation location")))


levels(tab4$colsN) <- c("purple", "red","orange",  "grey50")
levels(tab4$colsN) <- c( "yellow", "red","cyan", "blue")
table(tab4$colsN)
## 
## yellow    red   cyan   blue 
##     20    126    189      0
names(tab4)
##  [1] "Status"            "Exposure.Location" "Street"           
##  [4] "Suburb"            "Date"              "Arrival.Time"     
##  [7] "Departure.Time"    "Contact"           "lat"              
## [10] "lon"               "doubles"           "moved"            
## [13] "colsN"
tab4 %>%
  mutate(conDate = as.Date(lubridate::dmy(Date)),
         locName = as.factor(Exposure.Location))
##loc summaries
tab5 <- tab4 %>%
  mutate(conDate = as.Date(lubridate::dmy(Date)),
         locName = as.factor(Suburb)) 

a <- as.data.frame(table(tab5$locName))

colnames(a) <- c("locName", "contactcount")

# head(a)
# str(a)
# filter(a, contactcount >=1)

plotsumms <- right_join(tab5, a)
## Joining, by = "locName"
print(a)
##             locName contactcount
## 1           Ainslie            2
## 2            Amaroo            5
## 3            Barton            1
## 4         Belconnen           21
## 5           Braddon            6
## 6  Braddon & Turner            1
## 7           Calwell            3
## 8          Campbell            8
## 9  Canberra Airport            6
## 10    Canberra City           20
## 11            Casey           12
## 12        Charnwood            1
## 13          Chifley            1
## 14         Chisholm           14
## 15           Conder           14
## 16            Crace            1
## 17  Denman Prospect            1
## 18          Dickson           14
## 19            Evatt            1
## 20           Florey            4
## 21         Franklin            2
## 22         Fyshwick           19
## 23         Greenway           13
## 24         Griffith            2
## 25        Gungahlin           21
## 26           Hawker            3
## 27             Holt           15
## 28           Kaleen            2
## 29          Lyneham            2
## 30        Macquarie            4
## 31      Majura Park            3
## 32           Mawson           10
## 33         Mitchell            4
## 34      Narrabundah            4
## 35        Ngunnawal            3
## 36         Nicholls            2
## 37       Palmerston            3
## 38          Phillip           33
## 39         Pialligo            4
## 40 Public Transport           16
## 41           Turner            2
## 42        Wanniassa           10
## 43           Watson            4
## 44           Weston           17
## 45            Woden            2
str(a)
## 'data.frame':    45 obs. of  2 variables:
##  $ locName     : Factor w/ 45 levels "Ainslie","Amaroo",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ contactcount: int  2 5 1 21 6 1 3 8 6 20 ...
# Aggregate method
# labs <- paste(plotsumms$Exposure.Location, plotsumms$Date,plotsumms$Arrival.Time, plotsumms$Departure.Time, sep="<br/>") 

nrow(tab4)
## [1] 336
#> [1] 100
nrow(distinct(plotsumms, Suburb))
## [1] 45
b <- distinct(plotsumms, Suburb, .keep_all = TRUE)
# subsTable <- semi_join(tab4, b)


#> [1] 69
# nrow(distinct(df, x, y))
# #> [1] 69
levels(plotsumms$locName)
##  [1] "Ainslie"          "Amaroo"           "Barton"           "Belconnen"       
##  [5] "Braddon"          "Braddon & Turner" "Calwell"          "Campbell"        
##  [9] "Canberra Airport" "Canberra City"    "Casey"            "Charnwood"       
## [13] "Chifley"          "Chisholm"         "Conder"           "Crace"           
## [17] "Denman Prospect"  "Dickson"          "Evatt"            "Florey"          
## [21] "Franklin"         "Fyshwick"         "Greenway"         "Griffith"        
## [25] "Gungahlin"        "Hawker"           "Holt"             "Kaleen"          
## [29] "Lyneham"          "Macquarie"        "Majura Park"      "Mawson"          
## [33] "Mitchell"         "Narrabundah"      "Ngunnawal"        "Nicholls"        
## [37] "Palmerston"       "Phillip"          "Pialligo"         "Public Transport"
## [41] "Turner"           "Wanniassa"        "Watson"           "Weston"          
## [45] "Woden"
# distinct(df, x)
plotsumms <- b
plotsumms$Suburb[35] <- "O'Connor" 
plotsumms$locName[35] <- "O'Connor"
## Warning in `[<-.factor`(`*tmp*`, 35, value = structure(c(33L, 30L, 38L, :
## invalid factor level, NA generated
# plotsumms$Suburb <- droplevels(plotsumms$Suburb)
# plotsumms$locName <- droplevels(plotsumms$locName)

clean <- plotsumms$Exposure.Location[4] <- "Assembly The People Pub"

# pre-processing
# ensure that all characters in the `Name` column
# are valid UTF-8 encoded
# Thank you to SO for this gem 
# https://stackoverflow.com/questions/17291287/how-to-identify-delete-non-utf-8-characters-in-r
Encoding(x = plotsumms$Exposure.Location) <- "UTF-8"

# replace all non UTF-8 character strings with an empty space
plotsumms$Exposure.Location <-
  iconv( x = plotsumms$Exposure.Location
         , from = "UTF-8"
         , to = "UTF-8"
         , sub = "" )


labs <- paste(plotsumms$Exposure.Location, plotsumms$Date,plotsumms$Arrival.Time, plotsumms$Departure.Time, sep="<br/>") 

leaflet(plotsumms) %>% addTiles() %>%
  addCircleMarkers(lat=plotsumms$lat,
                            lng=plotsumms$lon,
                   weight = 0.2, 
    radius = log(plotsumms$contactcount)*5, 
                            color = plotsumms$colsN,
                            stroke = TRUE,
                            fill = rep("black", length(plotsumms$colsN)),
                            popup = paste0(" COUNT:", plotsumms$contactcount),
                            fillOpacity = 0.8
                            ) %>%
  addCircles(lat=tab4$lat,lng=tab4$lon,
             popup = paste0(plotsumms$Exposure.Location," ", plotsumms$Date))
# %>%
#     group_by(locName) %>%
#       summarise(countPlace = count(Place))
# # %>%
#   group_by(Suburb) %>%
#     summarise(FirstCase = min(conDate),
#               LastCase = max(conDate),
#               caseCount = sum(unique(Place)))

# write.csv(x = plotsumms, "data/outSubs.csv")

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.

Overall we can group locations and other attributes into different spatial areas. For mapping many projects the exact location is not know or is not needed/wanted for a range of obvious reasons. This set of functions takes the location information from each of the datasets and creates a uniform location entry that aligns with the desired spatial scale.

Existing datasets

Manual postcode grouping

My grouping

Here I have created for groups: North Canberra, Central Canberra,…..

Manual grouping into four general areas….

From ABS package

This package allows aspects of this data to be linked with census and other data resources associated with this level of geo-spatial identification.

LGA_2016 equates to total of ACT

Another abs level

All current locations in cases

SA3 statistical Areas

SA1 statistical Areas

Table

Plot

SA2 statistical Areas

Table

Plot

Total ACT Census data

plotly

Overall we can group locations and other attributes into different spatial areas. Here I have created for groups: North Canberra, Central Canberra,…..

Manual grouping into four general areas….

From ABS package

This package allows aspects of this data to be linked with census and other data resources associated with this level of geo-spatial identification.

LGA_2016 equates to total of ACT

Another abs level

All current locations in cases

merged to our cases